Monster Media 1996 #15/Monster Media Number 15 (Monster Media)(July 1996).ISO/tbbs/prgsourc.zip/HOMES.ZIP/MATCH.PRG

Text File | 1996-01-08 | 9KB | 369 lines

PARAMETERS md
PRIVATE cnt
aa[4] = pmax
aa[5] = sub
aa[6] = design
aa[8] = smin
aa[9] = lmin
aa[10] = bedmin
aa[11] = batmin
aa[13] = pump
aa[14] = base
aa[15] = fire
aa[16] = gar
aa[17] = air
p = aa[4] * 1000
STORE 0 TO m,m1,m2,m3
SELECT a
IF md = 3
   COUNT TO cnt
ELSE                                           && md = 4
   SEEK larea
   COUNT TO cnt WHILE area = larea
ENDIF
IF aa[5] = "..No Preference"
   IF aa[6] = "..Any          "
      IF md = 3
         COUNT TO m2 FOR price <= p .AND. size >= aa[8] .AND. acres >= aa[9] .AND. beds >= aa[10] .AND. baths >= aa[11]
         GOTO TOP
      ELSE
         SEEK larea
         COUNT TO m2 FOR price <= p .AND. size >= aa[8] .AND. acres >= aa[9] .AND. beds >= aa[10] .AND. baths >= aa[11] WHILE area = larea
         SEEK larea
      ENDIF
      IF m2 = 0
         fld="these selections"
         DO nmat
         RETURN
      ELSE
         DECLARE amat2[m2]            && Check against price,size,
         DO strtp
         SET ORDER TO 2
      ENDIF
   ELSE                    && A design is specified
      IF md = 3
         COUNT TO m1 FOR design = aa[6]
         GOTO TOP
      ELSE
         SEEK larea
         COUNT TO m1 FOR design = aa[6] WHILE area=larea
         SEEK larea
      ENDIF
      IF m1 = 0
         fld="this home design"
         DO nmat
         RETURN
      ELSE
         DECLARE amat1[m1]
         DO strtd
         SET ORDER TO 2
      ENDIF
      DECLARE amat2[m2]
      x = 1
      m3 = 0
      SEEK amat1[x]
      DO WHILE x < m2
         IF price <= p .AND. size >= aa[8] .AND. acres >= aa[9] .AND. beds >= aa[10] .AND. baths >= aa[11]
            m3 = m3 + 1
            amat2[m3] = pic1
         ENDIF
         x = x + 1
         SEEK amat1[x]
      ENDDO
      IF price <= p .AND. size >= aa[8] .AND. acres >= aa[9] .AND. beds >= aa[10] .AND. baths >= aa[11]
         m3 = m3 + 1
         amat2[m3] = pic1
      ENDIF
      RELEASE amat1
   ENDIF
ELSE                                      && A Subdivision is specified
   IF md = 3
      COUNT TO m FOR sub = aa[5]
      GOTO TOP
   ELSE                              && md = 4
      SEEK larea
      COUNT TO m FOR sub = aa[5] WHILE area=larea
      SEEK larea
   ENDIF
   IF m = 0
      fld="this subdivision"
      DO nmat
      RETURN
   ELSE
      DECLARE amat[m]
      DO strts
   ENDIF
   SET ORDER TO 2
   IF aa[6] = "..Any          "
      DECLARE amat1[m1]
      dummy = aCopy(amat,amat1)
      RELEASE amat
      m2=m1
      DECLARE amat2[m2]
      DO endp
   ELSE
      DECLARE amat1[m1]
      DO midd
      IF m2 = 0
         fld="the design & Sub"
         DO nmat
         RETURN
      ENDIF
      DECLARE amat2[m2]
      DO endp
   ENDIF
ENDIF
IF m3 = 0
   fld="these selections"
   DO nmat
   RELEASE amat2
   RETURN
ENDIF
y = 13
DO WHILE y <= 17
   IF aa[y]
      x = m3
      DO WHILE x > 0
         SEEK amat2[x]
         DO CASE
            CASE y = 13
                 IF .NOT. heatpump
                    dummy = aDel(amat2,x)
                    x = x - 1
                    m3 = m3 - 1
                    LOOP
                  ENDIF
            CASE y = 14
                 IF .NOT. basement
                    dummy = aDel(amat2,x)
                    x = x - 1
                    m3 = m3 - 1
                    LOOP
                 ENDIF
            CASE y = 15
                 IF fireplace = 0
                    dummy = aDel(amat2,x)
                    x = x - 1
                    m3 = m3 - 1
                    LOOP
                 ENDIF
            CASE y = 16
                 IF .NOT. garage
                    dummy = aDel(amat2,x)
                    x = x - 1
                    m3 = m3 - 1
                    LOOP
                 ENDIF
            CASE y = 17
                 IF .NOT. ac
                    dummy = aDel(amat2,x)
                    x = x - 1
                    m3 = m3 - 1
                    LOOP
                 ENDIF
         ENDCASE
         x = x - 1
      ENDDO
   ENDIF
   IF m3 = 0
      fld="these selections"
      DO nmat
      RELEASE amat2
      RETURN
   ENDIF
ENDDO
mat = m3
DO ty
DO BoxB WITH 5,52,8,72
@ 6,53 SAY mat PICTURE "@ 999"
IF mat = 1
   @ 6,Col()+1 SAY "match found"
ELSE
   @ 6,Col()+1 SAY "matches found"
ENDIF
@ 7,54 SAY "View Now?"
*******************
        @ 20,5 SAY "Pausing for 8 seconds...."
        key = InKey(8)
*******************
SET COLOR TO N/N
@ 2,0 GET charin
DO WHILE .T.
   READ
           DO CASE
              CASE LastKey() = 89 .OR. LastKey() = 121   && `Y' or `y'
                DECLARE amat3[m3]
                dummy = aCopy(amat2,amat3,1,m3,1)
                RELEASE amat2
                EXIT
              CASE LastKey() = 78 .OR. LastKey() = 110   && 'N' or 'n'
                RELEASE amat2
                RETURN
              OTHERWISE
                LOOP
           ENDCASE
        ENDDO
        x=1
        SEEK amat3[1]
        DO tt
        IF m3 # 1
                DO ts
        ENDIF
        DO vscr
        DO view
        SET FORMAT TO fscr NOCLEAR
        SET COLOR TO N/N
        @ 2,0 GET charin
        DO WHILE .T.
           READ
           DO CASE
              CASE Lastkey() = 27                   && <Esc>
                   EXIT
              CASE LastKey() = 5                    && <Up Arrow>
                   IF x=1
                      LOOP
                   ENDIF
                   x=x-1
                   SEEK amat3[x]
                   DO view
                   LOOP
              CASE LastKey() = 24                   && <Dn Arrow>
                   IF x = m3
                      LOOP
                   ENDIF
                   x=x+1
                   SEEK amat3[x]
                   DO view
                   LOOP

              CASE LastKey() = 84 .OR. LastKey() = 116          && T or t
                   DO tag WITH tg
              OTHERWISE
                   LOOP
           ENDCASE
        ENDDO
        RELEASE amat3
RETURN

**************************************************
PROCEDURE strts

x=1
DO WHILE x < cnt
   IF sub = aa[5]
      m1=m1+1
      amat[m1] = pic1
   ENDIF
   x=x+1
   SKIP
ENDDO
IF sub = aa[5]
   m1=m1+1
   amat[m1] = pic1
ENDIF
RETURN

**************************************************
PROCEDURE strtd

x=1
m2=0
DO WHILE x < cnt
   IF design = aa[6]
      m2=m2+1
      amat1[m2] = pic1
   ENDIF
   x=x+1
   SKIP
ENDDO
IF design = aa[6]
   m2=m2+1
   amat1[m2] = pic1
ENDIF
RETURN


**************************************************
PROCEDURE strtp

x = 1
m3 = 0
DO WHILE x < cnt
   IF price <= p .AND. size >= aa[8] .AND. acres >= aa[9] .AND. beds >= aa[10] .AND. baths >= aa[11]
      m3 = m3 + 1
      amat2[m3] = pic1
   ENDIF
   x = x + 1
   SKIP
ENDDO
IF price <= p .AND. size >= aa[8] .AND. acres >= aa[9] .AND. beds >= aa[10] .AND. baths >= aa[11]
   m3=m3+1
   amat2[m3] = pic1
ENDIF
RETURN


**************************************************
PROCEDURE midd

x=1
m2=0
SEEK amat[x]
DO WHILE x < m1
   IF design = aa[6]
      m2=m2+1
      amat1[m2] = pic1
   ENDIF
   x=x+1
   SEEK amat[x]
ENDDO
IF design = aa[6]
   m2=m2+1
   amat1[m2] = pic1
ENDIF
RELEASE amat
RETURN



**************************************************
PROCEDURE nmat

DO BoxB WITH 5,52,8,77
@ 6,54 SAY "No matches were found"
@ 7,54 SAY "for"
@ 7,Col()+1 SAY fld
key = inkey(3)
DO cls WITH 5,52,8,77

IF fld = "this subdivision" .OR. fld = "this home design"
   DO BoxB WITH 5,53,8,74
   @ 6,55 SAY "Press <Page Dn> to"
   @ 7,55 SAY "use the pick list"
   key = InKey(3)
   DO cls WITH 5,53,8,74
ENDIF
SET COLOR TO W+/N
RETURN
**************************************************
PROCEDURE endp

x=1
m3=0
SEEK amat1[x]
DO WHILE x < m2
   IF price <= p .AND. size >= aa[8] .AND. acres >= aa[9] .AND. beds >= aa[10] .AND. baths >= aa[11]
      m3=m3+1
      amat2[m3] = pic1
   ENDIF
   x=x+1
   SEEK amat1[x]
ENDDO
IF price <= p .AND. size >= aa[8] .AND. acres >= aa[9] .AND. beds >= aa[10] .AND. baths >= aa[11]
   m3=m3+1
   amat2[m3] = pic1
ENDIF
RELEASE amat1
RETURN